COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file
C00003 00003	.hd206 SPRING 1978
C00014 ENDMK
C⊗;
.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file;
.
.MACRO  hd206 (TERM) ⊂
.BEGIN    NOFILL  TURNON "←→"
.place heading
←COMPUTER SCIENCE DEPARTMENT
←STANFORD UNIVERSITY
.place text
CS206  ←COMPUTING WITH SYMBOLIC EXPRESSIONS  →TERM
.TURNOFF
.END ⊃
.LSPFONT
.FONT A "FIX25";
.basicops 
.itemmac 1;
.
.PORTION MAINPORTION
.hd206 SPRING 1978
.PAGE ← 1
.cb |Solutions to Midterm Exam|
.item←0

#. The ⊗depth of an S-expression is given by the length of the longest 
path to an atom.  
.BEGIN NOFILL 

⊗⊗        depth x ← qif qat x qthen 0 qelse add1 max[depth qa x, depth qd x]⊗
.END
.BEGIN NOFILL SELECT A

	(DEFUN DEPTH (X) 
	       (COND ((ATOM X) 0)
		     (T (ADD1 (MAX (DEPTH (CAR X)) (DEPTH (CDR X)))))))
.END
#. ⊗balanced[x] is true if and only if the S-expression is balanced.
We say that an S-expression is balanced if it is an atom or if
⊗⊗depth[qa x]⊗ and ⊗⊗depth[qd x]⊗ differ by at most 1
and qa ⊗x and qd ⊗x are both balanced.  
.BEGIN NOFILL 

⊗⊗        balanced x ← ⊗
⊗⊗            qif qat x qthen qT⊗
⊗⊗            qelse balanced qa x ∧ balanced qd x ∧ abs depth qa x - depth qd x < 2⊗
.END
.BEGIN NOFILL SELECT A  

	(DEFUN BALANCED (X) 
	       (COND ((ATOM X) T)
		     (T (AND (BALANCED (CAR X))
			     (BALANCED (CDR X))
			     (LESSP (ABS (DIFFERENCE (DEPTH (CAR X))
						     (DEPTH (CDR X))))
				    2)))))
.END
#.  Let ⊗g be an undirected graph represented as a list of lists as described
in Chapter I.  

    ##.  ⊗deleteα_vertex[v,g]  returns a graph ⊗g1 with vertices those of
⊗g omitting ⊗v, and edges the same as ⊗g omitting those connecting ⊗v to 
another vertex.
.BEGIN NOFILL 

⊗⊗        delver[v, g] ← ⊗
⊗⊗            qif qn g qthen qNIL⊗
⊗⊗            qelse qif v = qaa g qthen delver[v, qd g]⊗
⊗⊗            qelse remove[v, qa g] . delver[v, qd g]⊗

⊗⊗        remove[v, u] ← ⊗
⊗⊗            qif qn u qthen qNIL qelse qif v = qa u qthen qd u qelse qa u . remove[v, qd u]⊗
.END
.BEGIN NOFILL SELECT A

	(DEFUN DELVER (V G) 
	       (COND ((NULL G) NIL)
		     ((EQUAL V (CAAR G)) (DELVER V (CDR G)))
		     (T (CONS (REMOVE V (CAR G)) (DELVER V (CDR G))))))

	(DEFUN REMOVE (V U) 
	       (COND ((NULL U) NIL)
		     ((EQUAL V (CAR U)) (CDR U))
		     (T (CONS (CAR U) (REMOVE V (CDR U))))))
.END
.NEXT PAGE
    ##.  ⊗complement[g]  returns a graph ⊗g1 with vertices the same as ⊗g, but
vertices ⊗v and ⊗w are joined by an edge in ⊗g1 if and only if they are not
joined by an edge in ⊗g.  
.BEGIN NOFILL 

⊗⊗        complement g ← comp1[g, vertices g]⊗

⊗⊗        comp1[g, u] ← ⊗
⊗⊗            qif qn g qthen qNIL qelse [qaa g . vertdif[u, qa g]] . comp1[qd g, u]⊗

⊗⊗        vertices g ← mapcar[$$CAR$, g]⊗

⊗⊗        vertdif[u, v] ← qif qn v qthen u qelse vertdif[remove[qa v, u], qd v]⊗
.END
.BEGIN NOFILL SELECT A

	(DEFUN COMPLEMENT (G) (COMP1 G (VERTICES G)))

	(DEFUN COMP1 (G U) 
	       (COND ((NULL G) NIL)
		     (T (CONS (CONS (CAAR G) (VERTDIF U (CAR G)))
			      (COMP1 (CDR G) U)))))

	(DEFUN VERTICES (G) (MAPCAR 'CAR G))

	(DEFUN VERTDIF (U V) 
	       (COND ((NULL V) U) (T (VERTDIF (REMOVE (CAR V) U) (CDR V))))) 
.END
.NEXT PAGE
#.  Consider arithmetic expressions as represented in Ch I. Namely an
expression is 
.begin nofill
	(i) a number (satisfies ⊗numberp), 
	(ii) a variable (not a number and satisfies qqat),
	(iii) a sum : $PLUS . < list of expressions > or
	(iv) a product : $TIMES . < list of expressions >.
    (For simplicity, assume the sum and product lists always have at least 2 elements.)
.end
	The function ⊗sop converts such expressions into sum of products
form, eg. the resulting expression is either a monomial 
or a sum of monomial terms which has the form $$PLUS$_._<list_of_monomials>.
A monomial is either a number, a variable, or a product of the 
form $$TIMES$_._< list of numbers or variables >.

	To solve this problem you imagine that in the $PLUS and $TIMES cases
the list of arguments has been put into the desired form. (This is easily done
with a ⊗mapcar.)   In the $PLUS case all that is left to do is to merge the 
argument lists of any $PLUS terms into the main argument list which is done by
the function ⊗plussop.  In the $TIMES case it is necessary to multiply out all
the terms in the argument list.  This can be done by imagining that it has been
done for the ⊗cdr of the list and using ⊗distrib to multiply two normalform terms.
Here there are 4 cases depending on whether the terms are monomials or sums.
If at least one term is not a monomial the problem can be reduced to a
sequence of monomial multiplications by appropriate use of ⊗mapcar.  
⊗monprod does the actual monomial multiplication. Again there are 4 cases
depending upon whether the arguments are simple (number or variable) or
a product of two or more simple monomials.
.BEGIN NOFILL

⊗⊗        sop e ← qif qat e qthen e⊗
⊗⊗                qelse qif qa e = $$PLUS$ qthen $$PLUS$ . plussop mapcar[sop, qd e]⊗
⊗⊗                qelse qif qa e = $$TIMES$ qthen timesop mapcar[sop, qd e]⊗

⊗⊗        plussop u ← ⊗
⊗⊗            qif qn u qthen qNIL⊗
⊗⊗            qelse qif monomial qa u qthen qa u . plussop qd u⊗
⊗⊗            qelse qda u * plussop qd u⊗

⊗⊗        monomial e ← qat e ∨ qa e = $$TIMES$⊗

⊗⊗        timesop u ← qif qn qd u qthen qa u qelse distrib[qa u, timesop qd u]⊗

⊗⊗        distrib[s1, s2] ← ⊗
⊗⊗            qif monomial s2 qthen ⊗
⊗⊗                [qif monomial s1 qthen monprod[s1, s2]⊗
⊗⊗                 qelse $$PLUS$ . mapcar[[λx: monprod[x, s2]], qd s1]]⊗
⊗⊗            qelse qif monomial s1 qthen ⊗
⊗⊗                $$PLUS$ . mapcar[[λy: monprod[s1, y]], qd s2]⊗
⊗⊗            qelse $$PLUS$⊗
⊗⊗                  . mapcar[[λx: mapcar[[λy: monprod[x, y]], qd s2]], qd s1]⊗

⊗⊗        monprod[m1, m2] ← ⊗
⊗⊗            $$TIMES$ . [qif qat m1 qthen [qif qat m2 qthen <m1, m2> qelse m1 . qd m2]⊗
⊗⊗                        qelse qd m1 * [qif qat m2 qthen ncons m2 qelse qd m2]]⊗
.end
.NEXT PAGE
.begin nofill select a

    (DEFUN SOP (E) 
	   (COND ((ATOM E) E)
		 ((EQ (CAR E) 'PLUS)
		  (CONS 'PLUS
			(PLUSSOP (MAPCAR (FUNCTION SOP) (CDR E)))))
		 ((EQ (CAR E) 'TIMES)
		  (TIMESOP (MAPCAR (FUNCTION SOP) (CDR E))))))

    (DEFUN PLUSSOP (U) 
	   (COND ((NULL U) NIL)
		 ((MONOMIAL (CAR U)) (CONS (CAR U) (PLUSSOP (CDR U))))
		 (T (APPEND (CDAR U) (PLUSSOP (CDR U))))))

    (DEFUN MONOMIAL (E) (OR (ATOM E) (EQ (CAR E) 'TIMES)))

    (DEFUN TIMESOP (U) 
	   (COND ((NULL (CDR U)) (CAR U))
		 (T (DISTRIB (CAR U) (TIMESOP (CDR U))))))

    (DEFUN DISTRIB (S1 S2) 
	   (COND
	    ((MONOMIAL S2)
	     (COND ((MONOMIAL S1) (MONPROD S1 S2))
		   (T (CONS 'PLUS
			    (MAPCAR (FUNCTION (LAMBDA (X) (MONPROD X S2)))
				    (CDR S1))))))
	    ((MONOMIAL S1)
	     (CONS 'PLUS
		   (MAPCAR (FUNCTION (LAMBDA (Y) (MONPROD S1 Y))) (CDR S2))))
	    (T
	     (CONS
	      'PLUS
	      (MAPCAR 
	       (FUNCTION (LAMBDA (X) (MAPCAR (FUNCTION (LAMBDA (Y) 
							       (MONPROD X Y)))
					     (CDR S2))))
	       (CDR S1))))))

    (DEFUN MONPROD (M1 M2) 
	   (CONS 'TIMES
		 (COND ((ATOM M1)
			(COND ((ATOM M2) (LIST M1 M2))
			      (T (CONS M1 (CDR M2)))))
		       (T (APPEND (CDR M1)
				  (COND ((ATOM M2) (NCONS M2))
					(T (CDR M2)))))))) 
.end